home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / tjgold.zip / INSTALL.001 / DFBTREE.INC next >
Text File  |  1995-07-19  |  35KB  |  949 lines
  1. {--------------------------------------------------------------------------}
  2. {                Product: TechnoJock's Turbo Toolkit                       }
  3. {                Version: GOLD                                             }
  4. {                Build:   1.01                                             }
  5. {                                                                          }
  6. {  The index routines used in TTT Gold were developed by Dean Farwell II   }
  7. {  and are an adaptation of his excellent TBTREE database tools.           }
  8. {                                                                          }
  9. {                   Copyright 1988-1994 Dean Farwell II                    }
  10. {        Portions Copyright 1986-1995  TechnoJock Software, Inc.           }
  11. {                           All Rights Reserved                            }
  12. {                          Restricted by License                           }
  13. {--------------------------------------------------------------------------}
  14.  
  15.                      {********************************}
  16.                      {     Include:   DFBTREE         }
  17.                      {********************************}
  18.  
  19. (******************************************************************************)
  20. (*                                                                           *)
  21. (*               B T R E E   C U R S O R   R O U T I N E S                   *)
  22. (*                                                                           *)
  23. (*****************************************************************************)
  24.  
  25. (* This routine will return the logical record associated with the cursor.
  26.    If the cursor in not valid, 0 will be returned.                           *)
  27.  
  28. function LrNumToReturn(var pg : SinglePage;            (* var for speed only *)
  29.                        var pRec : ParameterRecord      (* var for speed only *)
  30.                        ) : LrNumber;
  31.  
  32. var
  33.     lrNum : LrNumber;
  34.  
  35.     begin
  36.     if pRec.cursor.valid then
  37.         begin
  38.         Move(pg[((pRec.cursor.entryNum - 1) * (pRec.vSize + RNSIZE)) + 1],
  39.              lrNum,
  40.              RNSIZE);
  41.         end
  42.     else
  43.         begin
  44.         lrNum := 0;
  45.         end;
  46.     LrNumToReturn := lrNum;
  47.     end;                                     (* end of LrNumToReturn routine *)
  48.  
  49. (*\*)
  50. (* This routine will set the tree cursor to the front of the index.  In
  51.    other words, it will point to the first entry in the index.  Remember, the
  52.    index is ordered by the value of each entry.  It will also return the
  53.    logical record associated with the first entry in the index.  It will
  54.    return 0 only if there is no first entry (the index is empty).  This
  55.    routine should be called if you want to start at the beginning of an index
  56.    and want to retrieve logical record numbers in order of entry.            *)
  57.  
  58. function UsingCursorGetFirstLr(iFName : FnString;
  59.                                var fId : File          (* var for speed only *)
  60.                                ) : LrNumber;
  61.  
  62. var
  63.     pRec : ParameterRecord;
  64.     pg : SinglePage;
  65.  
  66.     begin
  67.     FetchFileParameters(iFName,fId,pRec,SizeOf(pRec));
  68.     if BTreeErrorOccurred then Exit;
  69.  
  70.     FetchPage(iFName,fId,pRec.fSNode,pg);
  71.     if BTreeErrorOccurred then Exit;
  72.  
  73.     if pg[VCNTLOC] > 0 then
  74.         begin
  75.         pRec.cursor.prNum := pRec.fSNode;
  76.         pRec.cursor.entryNum := 1;
  77.         pRec.cursor.valid := TRUE;
  78.         end
  79.     else
  80.         begin
  81.         pRec.cursor.valid := FALSE;
  82.         end;
  83.  
  84.     SaveFileParameters(iFName,fId,pRec,SizeOf(pRec));
  85.     if BTreeErrorOccurred then Exit;
  86.  
  87.     UsingCursorGetFirstLr := LrNumToReturn(pg,pRec);
  88.     end;                             (* end of UsingCursorGetFirstLr routine *)
  89.  
  90. (*\*)
  91. (* This routine will set the tree cursor to the end of the index.  In
  92.    other words, it will point to the first entry in the index.  Remember, the
  93.    index is ordered by the value of each entry.  It will also return the
  94.    logical record associated with the last entry in the index.  It will
  95.    return 0 only if there is no last entry (the index is empty).  This
  96.    routine should be called if you want to start at the end of an index
  97.    and want to retrieve logical record numbers in reverse order of entry.   *)
  98.  
  99. function UsingCursorGetLastLr(iFName : FnString;
  100.                               var fId : File          (* var for speed only *)
  101.                               ) : LrNumber;
  102.  
  103. var
  104.     pRec : ParameterRecord;
  105.     pg : SinglePage;
  106.     prevNode : NodePtrType;
  107.  
  108.     begin
  109.     FetchFileParameters(iFName,fId,pRec,SizeOf(pRec));
  110.     if BTreeErrorOccurred then Exit;
  111.  
  112.     FetchPage(iFName,fId,pRec.lSNode,pg);
  113.     if BTreeErrorOccurred then Exit;
  114.  
  115.     if pg[VCNTLOC] > 0 then
  116.         begin
  117.         pRec.cursor.prNum := pRec.lSNode;
  118.         pRec.cursor.entryNum := pg[VCNTLOC];
  119.         pRec.cursor.valid := TRUE;
  120.         end
  121.     else
  122.         begin
  123.         Move(pg[PREVLOC],prevNode,RNSIZE);
  124.         if prevNode <> NULL then
  125.             begin
  126.             FetchPage(iFName,fId,prevNode,pg);
  127.             if BTreeErrorOccurred then Exit;
  128.             pRec.cursor.prNum := prevNode;
  129.             pRec.cursor.entryNum := pg[VCNTLOC];
  130.             pRec.cursor.valid := TRUE;
  131.             end
  132.         else
  133.             begin
  134.             pRec.cursor.valid := FALSE;
  135.             end;
  136.         end;
  137.     SaveFileParameters(iFName,fId,pRec,SizeOf(pRec));
  138.     if BTreeErrorOccurred then Exit;
  139.     UsingCursorGetLastLr := LrNumToReturn(pg,pRec);
  140.     end;                              (* end of UsingCursorGetLastLr routine *)
  141.  
  142. (*\*)
  143. (* This routine is the same as UsingCursorAndValueGetLr except that this
  144.    routine will set the tree cursor to the location of the first value in the
  145.    index which is greater than or equal to paramValue.  It will also return
  146.    the logical record associated with this entry.  It will return 0 if there
  147.    is no entry which is greater than or equal to this value.                 *)
  148.  
  149. function UsingCursorAndGEValueGetLr(iFName : FnString;
  150.                                     var fId : File;    (* var for speed only *)
  151.                                     var paramValue;
  152.                                     partial : Boolean) : LrNumber;
  153. var
  154.     pRec : ParameterRecord;
  155.     pg : SinglePage;
  156.     cnt : Byte;               (* used to count number of values *)
  157.     bytePtr : PageRange;      (* used to keep track of current byte *)
  158.     thisNode : NodePtrType;
  159.  
  160.     begin
  161.     FetchFileParameters(iFName,fId,pRec,SizeOf(pRec));
  162.     if BTreeErrorOccurred then Exit;
  163.  
  164.     thisNode := FindSNode(iFName,fId,pRec.rNode,paramValue,pRec);
  165.     if BTreeErrorOccurred then Exit;
  166.  
  167.     FetchPage(iFName,fId,thisNode,pg);
  168.     if BTreeErrorOccurred then Exit;
  169.  
  170.     cnt := BinarySearchEntry(pg,paramValue,pRec);
  171.     if (cnt <> 0) and (cnt <= pg[VCNTLOC]) then
  172.         begin
  173.         bytePtr := BytePointerPosition(cnt,pRec.vsize);
  174.         pRec.cursor.prNum := thisNode;
  175.         pRec.cursor.entryNum := cnt;
  176.         pRec.cursor.valid := TRUE;
  177.         end
  178.     else
  179.         begin
  180.         pRec.cursor.valid := FALSE;
  181.         end;
  182.  
  183.     SaveFileParameters(iFName,fId,pRec,SizeOf(pRec));
  184.     if BTreeErrorOccurred then Exit;
  185.  
  186.     UsingCursorAndGEValueGetLr := LrNumToReturn(pg,pRec);
  187.     end;                         (* end of UsingCursorAndGEValueGetLr routine *)
  188.  
  189. (*\*)
  190. (* This routine will move the cursor to the right one entry and return the
  191.    value associated with this entry.  It will return 0 if the cursor was not
  192.    valid (not pointing to an entry) or if there is no next entry (you are at
  193.    end of index).  This routine should be called if you want to move the
  194.    cursor to the next larger entry from the present cursor position and
  195.    retrieve the associated logical record number.  This routine should not
  196.    normally be used until the cursor has been positioned using one of the
  197.    three previous positioning routines.                                      *)
  198.  
  199. function UsingCursorGetNextLr(iFName : FnString;
  200.                               var fId : File          (* var for speed only *)
  201.                              ) : LrNumber;
  202.  
  203. var
  204.     pRec : ParameterRecord;
  205.     pg : SinglePage;
  206.  
  207.     begin
  208.     FetchFileParameters(iFName,fId,pRec,SizeOf(pRec));
  209.     if BTreeErrorOccurred then Exit;
  210.  
  211.     if pRec.cursor.valid then
  212.         begin
  213.         FetchPage(iFName,fId,pRec.cursor.prNum,pg);
  214.         if BTreeErrorOccurred then Exit;
  215.         Inc(pRec.cursor.entryNum);
  216.         if pRec.cursor.entryNum > pg[VCNTLOC] then
  217.             begin
  218.             Move(pg[NEXTLOC],pRec.cursor.prNum,RNSIZE);
  219.             if pRec.cursor.prNum = NULL then
  220.                 begin
  221.                 pRec.cursor.valid := FALSE;
  222.                 end
  223.             else
  224.                 begin
  225.                 FetchPage(iFName,fId,pRec.cursor.prNum,pg);
  226.                 if BTreeErrorOccurred then Exit;
  227.                 if pg[VCNTLOC] = 0 then
  228.                     begin
  229.                     pRec.cursor.valid := FALSE;
  230.                     end
  231.                 else
  232.                     begin
  233.                     pRec.cursor.entryNum := 1;
  234.                     end;
  235.                 end;
  236.             end;
  237.         SaveFileParameters(iFName,fId,pRec,SizeOf(pRec));
  238.         if BTreeErrorOccurred then Exit;
  239.         end;
  240.     UsingCursorGetNextLr := LrNumToReturn(pg,pRec);
  241.     end;                              (* end of UsingCursorGetNextLr routine *)
  242.  
  243.  
  244. (* This routine will move the cursor to the left one entry and return the
  245.    value associated with this entry.  It will return 0 if the cursor was not
  246.    valid (not pointing to an entry) or if there is no next entry (you are at
  247.    end of index).  This routine should be called if you want to move the
  248.    cursor to the next larger entry from the present cursor position and
  249.    retrieve the associated logical record number.  This routine should not
  250.    normally be used until the cursor has been positioned using one of the
  251.    previous positioning routines.                                            *)
  252.  
  253. function UsingCursorGetPrevLr(iFName : FnString;
  254.                               var fId : File          (* var for speed only *)
  255.                               ) : LrNumber;
  256.  
  257. var
  258.     pRec : ParameterRecord;
  259.     pg : SinglePage;
  260.  
  261.     begin
  262.     FetchFileParameters(iFName,fId,pRec,SizeOf(pRec));
  263.     if BTreeErrorOccurred then Exit;
  264.  
  265.     if pRec.cursor.valid then
  266.         begin
  267.         FetchPage(iFName,fId,pRec.cursor.prNum,pg);
  268.         if BTreeErrorOccurred then Exit;
  269.         Dec(pRec.cursor.entryNum);
  270.         if pRec.cursor.entryNum = 0 then
  271.             begin
  272.             Move(pg[PREVLOC],pRec.cursor.prNum,RNSIZE);
  273.             if pRec.cursor.prNum = NULL then
  274.                 begin
  275.                 pRec.cursor.valid := FALSE;
  276.                 end
  277.             else
  278.                 begin
  279.                 FetchPage(iFName,fId,pRec.cursor.prNum,pg);
  280.                 if BTreeErrorOccurred then Exit;
  281.                 if pg[VCNTLOC] = 0 then
  282.                     begin
  283.                     pRec.cursor.valid := FALSE;
  284.                     end
  285.                 else
  286.                     begin
  287.                     pRec.cursor.entryNum := pg[VCNTLOC];
  288.                     end;
  289.                 end;
  290.             end;
  291.         SaveFileParameters(iFName,fId,pRec,SizeOf(pRec));
  292.         if BTreeErrorOccurred then Exit;
  293.         end;
  294.     UsingCursorGetPrevLr := LrNumToReturn(pg,pRec);
  295.     end;                              (* end of UsingCursorGetPrevLr routine *)
  296.  
  297.  
  298. (* This routine will not move the cursor.  It will return the logical record
  299.    number associated with the current cursor position.  It will return 0 only
  300.    if the current cursor position is not valid.                              *)
  301.  
  302. function UsingCursorGetCurrLr(iFName : FnString;
  303.                               var fId : File           (* var for speed only *)
  304.                               ) : LrNumber;
  305.  
  306. var
  307.     pRec : ParameterRecord;
  308.     pg : SinglePage;
  309.  
  310.     begin
  311.     FetchFileParameters(iFName,fId,pRec,SizeOf(pRec));
  312.     if BTreeErrorOccurred then Exit;
  313.  
  314.     if pRec.cursor.valid then
  315.         begin
  316.         FetchPage(iFName,fId,pRec.cursor.prNum,pg);
  317.         if BTreeErrorOccurred then Exit;
  318.         end;
  319.  
  320.     UsingCursorGetCurrLr := LrNumToReturn(pg,pRec);
  321.     end;                              (* end of UsingCursorGetCurrLr routine *)
  322.  
  323.  
  324. (* This routine will not move the cursor.  It will return the index entry
  325.    (data value) associated with the current cursor position.  If the current
  326.    cursor position is not valid, paramValue will be returned unchanged.  You
  327.    can use UsingCursorGetCurrLr to check the cursor before calling this
  328.    routine, if desired.                                                      *)
  329.  
  330. procedure UsingCursorGetCurrValue(iFName : FnString;
  331.                                   var fId : File;      (* var for speed only *)
  332.                                   var paramValue);
  333.  
  334. var
  335.     pRec : ParameterRecord;
  336.     pg : SinglePage;
  337.  
  338.     begin
  339.     FetchFileParameters(iFName,fId,pRec,SizeOf(pRec));
  340.     if BTreeErrorOccurred then Exit;
  341.  
  342.     if pRec.cursor.valid then
  343.         begin
  344.         FetchPage(iFName,fId,pRec.cursor.prNum,pg);
  345.         if BTreeErrorOccurred then Exit;
  346.         Move(pg[((pRec.cursor.entryNum - 1) * (pRec.vSize + RNSIZE)) +
  347.                 (1 + RNSIZE)],
  348.              paramValue,
  349.              pRec.vSize);
  350.         end;
  351.     end;                           (* end of UsingCursorGetCurrValue routine *)
  352.  
  353.  
  354. (* This routine will allow you to save a cursor in memory.  The current state
  355.    of the cursor will be passed back to you in the parameter cursor.  It is
  356.    handy if you want to keep track of where you are in a list or check values
  357.    associated with a cursor.                                                *)
  358.  
  359. procedure GetCursorState(iFName : FnString;
  360.                          var fId : File;              (* var for speed only *)
  361.                          var cursor : TreeCursor);
  362.  
  363. var
  364.     pRec : ParameterRecord;
  365.  
  366.     begin
  367.     FetchFileParameters(iFName,fId,pRec,SizeOf(pRec));
  368.     if BTreeErrorOccurred then Exit;
  369.  
  370.     cursor := pRec.cursor;
  371.     end;                                    (* end of GetCursorState routine *)
  372.  
  373.  
  374. (*****************************************************************************)
  375. (*                                                                           *)
  376. (*                  B T R E E   M I S C   R O U T I N E S                    *)
  377. (*                                                                           *)
  378. (*****************************************************************************)
  379.  
  380. (* This routine will create an index file with the file name as specified
  381.    by iFName.  The valSize parameter specifies the size of the index
  382.    entries.  The easiest way to determine this is to use the SizeOf
  383.    function.  The valType parameter specifies the type for the index
  384.    entries.  The types supported are those enumerated by the ValueType
  385.    enumerated type.
  386.  
  387.    note - Extremely important - WARNING - for STRINGVALUE indexes only - the
  388.    valSize must be 1 greater than the number of characters of the longest
  389.    string.  This will allow 1 byte for the string length to be stored.
  390.    for example - if 'abc' is the longest string then valSize = 4.            *)
  391.  
  392. procedure CreateIndexFile(iFName : FnString;
  393.                           var fId : File;
  394.                           valSize : VSizeType;
  395.                           valType : ValueType;
  396.                           indexedField : Integer;
  397.                           upperCase : Boolean);
  398.  
  399. var
  400.     pRec : ParameterRecord;
  401.     pg : SinglePage;
  402.  
  403.     begin
  404.     ReleaseAllPages(iFName);
  405.  
  406.     FillChar(pg,PAGESIZE,0);
  407.     StorePage(iFName,fId,0,pg);                          (* parameter record *)
  408.     if BTreeErrorOccurred then Exit;
  409.  
  410.     StorePage(iFName,fId,1,pg);                             (* bitmap record *)
  411.     if BTreeErrorOccurred then Exit;
  412.  
  413.     FetchFileParameters(iFName,fId,pRec,SizeOf(pRec));
  414.     if BTreeErrorOccurred then Exit;
  415.  
  416.     pRec.version := VERSIONINFO;
  417.     pRec.nextAvail  := 1;
  418.     pRec.firstBMRec := 1;
  419.     pRec.lastBMRec  := 1;
  420.     pRec.vSize := valSize;
  421.     pRec.rNode := CreatedNode(iFName,fId,NULL,NULL,INDEXNODE,pRec);
  422.                                                               (* create root *)
  423.     if BTreeErrorOccurred then Exit;
  424.  
  425.     pRec.fSNode := NULL;
  426.     pRec.lSNode := NULL;
  427.     pRec.fSNode := CreatedNode(iFName,fId,NULL,NULL,SEQUENCENODE,pRec);
  428.                                                (* create first Sequence node *)
  429.     if BTreeErrorOccurred then Exit;
  430.  
  431.     FetchPage(iFName,fId,pRec.rNode,pg);                    (* get root page *)
  432.     if BTreeErrorOccurred then Exit;
  433.  
  434.     Move(pRec.fSNode,pg[1],RNSIZE);                  (* put seq node in root *)
  435.     StorePage(iFName,fId,pRec.rNode,pg);                   (* store the root *)
  436.     if BTreeErrorOccurred then Exit;
  437.  
  438.     pRec.vType := valType;
  439.     pRec.cursor.prNum := 0;
  440.     pRec.cursor.entryNum := 0;
  441.     pRec.cursor.valid := FALSE;
  442.     pRec.iField := indexedField;
  443.     pRec.UpperCaseFlag := upperCase;
  444.     SaveFileParameters(iFName,fId,pRec,SizeOf(pRec));      (* write parameters
  445.                                                               back to buffer *)
  446.     end;                                       (* end of CreateIndex routine *)
  447.  
  448. (*\*)
  449. (* This routine will insert a value and its associated logical record number
  450.    into the given index file.  This routine will guard against duplicate
  451.    entries. An index should have no more than one occurence of any
  452.    lrNum,paramValue pair (no two entries match on paramValue and lrNum).  This
  453.    routine assures this by calling DeleteValueFromBTree prior to performing
  454.    the insert.  This will get rid of a previous occurence if it exists.      *)
  455.  
  456. procedure InsertValueInBTree(iFName : FnString;
  457.                              var fId : File;           (* var for speed only *)
  458.                              lrNum : LRNumber;
  459.                              var paramValue);
  460.  
  461. var
  462.     lowerNode : PrNumber;
  463.     pRec : ParameterRecord;
  464.     lowerPage,
  465.     pg: SinglePage;                (* used for root and first seq node pages *)
  466.     lastValLoc : PageRange;                  (* used to hold buffer position *)
  467.     nextNode : NodePtrType;            (* needed for inserting on root split *)
  468.  
  469.     begin
  470. {    DeleteValueFromBTree(iFName,lrNum,paramValue);   (* ensure no duplicates *)}
  471.     FetchFileParameters(iFName,fId,pRec,SizeOf(pRec));
  472.     if BTreeErrorOccurred then Exit;
  473.  
  474.     lowerNode := InsertValue(iFName,fId,lrNum,paramValue,pRec.rNode,pRec);
  475.     if BTreeErrorOccurred then Exit;
  476.  
  477.     if lowerNode <> NULL then
  478.         begin                                (* we need to create a new root *)
  479.         pRec.rNode := CreatedNode(iFName,fId,NULL,NULL,INDEXNODE,pRec);
  480.                                                     (* root has  no siblings *)
  481.         if BTreeErrorOccurred then Exit;
  482.  
  483.         FetchPage(iFName,fId,pRec.rNode,pg);                    (* get root node *)
  484.         if BTreeErrorOccurred then Exit;
  485.  
  486.         FetchPage(iFName,fId,lowerNode,lowerPage);             (* get child node *)
  487.         if BTreeErrorOccurred then Exit;
  488.  
  489.         lastValLoc := (((lowerPage[VCNTLOC] - 1)
  490.                          * ( pRec.vSize + RNSIZE)) + RNSIZE) + 1;
  491.  
  492.         Move(lowerPage[NEXTLOC],pg[1],RNSIZE);
  493.                                                (* insert ptr for right child *)
  494.         Move(pg[1],nextNode,RNSIZE);
  495.         InsertValueIntoNode(pg,                    (* insert child into root *)
  496.                             lowerPage[lastValLoc],
  497.                             lowerNode,nextNode,pRec);
  498.         StorePage(iFName,fId,pRec.rNode,pg);
  499.         if BTreeErrorOccurred then Exit;
  500.         end;
  501.  
  502.     SaveFileParameters(iFName,fId,pRec,SizeOf(pRec));
  503.     end;                                (* end of InsertValueInBTree routine *)
  504.  
  505.  
  506. (* This routine will delete a value and its associated logical record number
  507.    from a given index file.  Only the entry with the matching paramValue and
  508.    the matching logical record number will be deleted.                       *)
  509.  
  510. procedure DeleteValueFromBTree(iFName : FnString;
  511.                                var fId : File;         (* var for speed only *)
  512.                                lrNum : LrNumber;
  513.                                var paramValue);
  514.  
  515. var
  516.     pRec : ParameterRecord;
  517.     last,
  518.     nodeDeleted : Boolean;
  519.  
  520.     begin
  521.     FetchFileParameters(iFName,fId,pRec,SizeOf(pRec));
  522.     if BTreeErrorOccurred then Exit;
  523.  
  524.     if DeleteValue(iFName,fId,lrNum,paramValue,
  525.                    pRec.rNode,pRec,last,nodeDeleted) then ;
  526.     if BTreeErrorOccurred then Exit;
  527.  
  528.     SaveFileParameters(iFName,fId,pRec,SizeOf(pRec));
  529.     end;                                      (* end of DeleteValueFromBTree *)
  530.  
  531. (*\*)
  532. (* This routine will start at the root node and return the number of levels
  533. that exist in a BTree.  The index file name is the only required input.      *)
  534.  
  535. function NumberOfBTreeLevels(iFName : FnString;
  536.                              var fId : File            (* var for speed only *)
  537.                              ) : Byte;
  538.  
  539. var
  540.     pRec : ParameterRecord;
  541.     pg : SinglePage;
  542.  
  543.     function CountLevels(thisNode : NodePtrType) : Byte;
  544.  
  545.     var
  546.         lowerNode : NodePtrType;
  547.  
  548.         begin
  549.         FetchPage(iFName,fId,thisNode,pg);
  550.         if BTreeErrorOccurred then Exit;
  551.  
  552.         case NodeType(pg[NTYPELOC]) of
  553.             INDEXNODE :
  554.                 begin
  555.                 Move(pg,lowerNode,RNSIZE);
  556.                 CountLevels := CountLevels(lowerNode) + 1;
  557.                 end;
  558.             SEQUENCENODE :
  559.                 begin
  560.                 CountLevels := 1;
  561.                 end;
  562.             end;                                    (* end of case statement *)
  563.         end;                                   (* end of CountLevels routine *)
  564.  
  565.     begin
  566.     FetchFileParameters(iFName,fId,pRec,SizeOf(pRec));
  567.     if BTreeErrorOccurred then Exit;
  568.     NumberOfBTreeLevels := CountLevels(pRec.rNode);
  569.     end;                               (* end of NumberOfBTreeLevels routine *)
  570.  
  571. (*\*)
  572. (* This routine will search an index and determine whether the given logical
  573.    record number is in the index.  If it is, TRUE is returned in found and the
  574.    value associated with the logical record number is returned in paramValue.
  575.    If it is not found, found will be returned as FALSE and paramValue will
  576.    remain unchanged.  This is primarily used for debugging or determining if
  577.    an index has somehow been damaged.                                        *)
  578.  
  579. procedure FindLrNumInBTree(iFName : FnString;
  580.                            var fId : File;             (* var fpr speed only *)
  581.                            lrNum : LrNumber;
  582.                            var paramValue;
  583.                            var found : Boolean);
  584.  
  585. var
  586.     pRec : ParameterRecord;
  587.     pg : SinglePage;
  588.     tempLrNum : LrNumber;
  589.     node : NodePtrType;
  590.     cnt,
  591.     vCnt : Byte;
  592.     bytePtr : PageRange;
  593.  
  594.     begin
  595.     FetchFileParameters(iFName,fId,pRec,SizeOf(pRec));
  596.     if BTreeErrorOccurred then Exit;
  597.  
  598.     node := pRec.fSNode;
  599.     found := FALSE;
  600.  
  601.     while node <> NULL do
  602.         begin
  603.         FetchPage(iFName,fId,node,pg);
  604.         if BTreeErrorOccurred then Exit;
  605.         vCnt := pg[VCNTLOC];
  606.         cnt := 1;
  607.         bytePtr := 1;
  608.         while cnt <= vCnt do
  609.             begin
  610.             Move(pg[bytePtr],tempLrNum,RNSIZE);
  611.             if tempLrNum = lrNum then
  612.                 begin
  613.                 found := TRUE;
  614.                 Move(pg[bytePtr + RNSIZE],paramValue,pRec.vSize);
  615.                 Exit;
  616.                 end
  617.             else
  618.                 begin
  619.                 Inc(cnt);
  620.                 if cnt <= vCnt then
  621.                     begin               (* required to keep bytePtr in range *)
  622.                     bytePtr := bytePtr + RNSIZE + pRec.vSize;
  623.                     end;
  624.                 end;
  625.             end;
  626.         Move(pg[NEXTLOC],node,RNSIZE);            (* set up to get next node *)
  627.         end;
  628.     end;                                  (* end of FindLrNumInBTree routine *)
  629.  
  630. (*\*)
  631. (* This routine will return a count of the number of entries in the index.   *)
  632.  
  633. function IndexEntryCount(iFName : FnString;
  634.                          var fId : File                (* var for speed only *)
  635.                          ) : LrNumber;
  636.  
  637. var
  638.     pRec : ParameterRecord;
  639.     cnt,
  640.     node : NodePtrType;
  641.     pg : SinglePage;
  642.  
  643.     begin
  644.     FetchFileParameters(iFName,fId,pRec,SizeOf(pRec));
  645.     if BTreeErrorOccurred then Exit;
  646.  
  647.     cnt := 0;
  648.     node := pRec.fSNode;
  649.     while node <> NULL do
  650.         begin
  651.         FetchPage(iFName,fId,node,pg);
  652.         if BTreeErrorOccurred then Exit;
  653.         cnt := cnt + pg[VCNTLOC];
  654.         Move(pg[NEXTLOC],node,RNSIZE);
  655.         end;
  656.     IndexEntryCount := cnt;
  657.     end;                                  (* end of IndexEntryFCount routine *)
  658.  
  659. (*\*)
  660. (* This routine will print out information regarding the index file.  It is
  661.    designed to aid in my debugging, but is available for your use as well.
  662.    The nodeInfo paramter is used to specify whether you want the information
  663.    for each node in the index to be printed.                                 *)
  664.  
  665. procedure PrintBTreeInfo(iFName : FnString;
  666.                          var fId : File;               (* var for speed only *)
  667.                          nodeInfo : Boolean;
  668.                          var lst : PrintTextDevice);
  669.  
  670. const
  671.     LEVEL = 0;
  672.  
  673. var
  674.     pRec : ParameterRecord;
  675.     pg : SinglePage;
  676.  
  677.     (* Print information for each node for this level *)
  678.  
  679.     procedure PrintLevelInfo(thisNode : NodePtrType;
  680.                              level : Byte);
  681.  
  682.     var
  683.         lowerNode : NodePtrType;
  684.         first : Boolean;
  685.         s : String[8];
  686.  
  687.         begin
  688.         Inc(level);
  689.         Writeln(lst);
  690.         Writeln(lst,'Node Information for level ',level);
  691.         first := TRUE;
  692.         while thisNode <> 0 do
  693.             begin
  694.             FetchPage(iFName,fId,thisNode,pg);
  695.             if BTreeErrorOccurred then Exit;
  696.             if first then
  697.                 begin
  698.                 first := FALSE;
  699.                 Move(pg,lowerNode,RNSIZE);
  700.                 end;
  701.             Writeln(lst);
  702.             Write(lst,'    Number of entries = ',pg[VCNTLOC]);
  703.             Write(lst,'   Physical Record Number = ',thisNode);
  704.             case NodeType(pg[NTYPELOC]) of
  705.                 INVALIDNODETYPE : s := 'INVALID';
  706.                 INDEXNODE : s := 'INDEX';
  707.                 SEQUENCENODE : s := 'SEQUENCE';
  708.                 else s := 'ERROR';
  709.                 end;
  710.             Writeln(lst,'   Node Type = ',s);
  711.             Writeln(lst,'    Lowest Value in Node = ',
  712.                         ConvertValueToString(pg[RNSIZE + 1],pRec.vType));
  713.             Writeln(lst,'    Highest Value in node = ',
  714.                          ConvertValueToString(pg[((RNSIZE + pRec.vSize) *
  715.                                              (pg[VCNTLOC] -1)) + RNSIZE + 1],
  716.                                              pRec.vType));
  717.             Move(pg[NEXTLOC],thisNode,RNSIZE);
  718.             end;
  719.         if NodeType(pg[NTYPELOC]) = INDEXNODE then
  720.             begin
  721.             PrintLevelInfo(lowerNode,level);
  722.             end;
  723.         end;
  724.  
  725.     begin
  726.  
  727.     FetchFileParameters(iFName,fId,pRec,SizeOf(pRec));
  728.     if BTreeErrorOccurred then Exit;
  729.  
  730.     Writeln(lst);
  731.     Writeln(lst,'The following is index file information');
  732.     Writeln(lst,'Index File Name = ',iFName);
  733.     Writeln(lst,'Next Available Node (physical record) = ',pRec.nextAvail);
  734.     Writeln(lst,'First Bitmap Record = ',pRec.firstBMRec);
  735.     Writeln(lst,'Last Bitmap Record = ',pRec.lastBMRec);
  736.     Writeln(lst,'Size of each index entry = ',pRec.vSize);
  737.     Writeln(lst,'Type of each index entry = ',Byte(pRec.vType));
  738.     Writeln(lst,'Maximum index entries per node = ',MaxEntries(pRec.vSize));
  739.     Writeln(lst,'Total number of index entries = ',IndexEntryCount(iFName,fId));
  740.     if BTreeErrorOccurred then Exit;
  741.  
  742.     Writeln(lst,'Root Node = ',pRec.rNode);
  743.     Writeln(lst,'First Sequence Node = ',pRec.fSNode);
  744.     Writeln(lst,'Last Sequence Node = ',pRec.lSNode);
  745.     Writeln(lst,'Number of levels = ',NumberOfBTreeLevels(iFName,fId));
  746.     if BTreeErrorOccurred then Exit;
  747.  
  748.     if nodeInfo then
  749.         begin
  750.         PrintLevelInfo(pRec.rNode,level);
  751.         end;
  752.     Writeln(lst);
  753.     end;                                    (* end of PrintBTreeInfo routine *)
  754.  
  755.  
  756. (* This routine returns the field number of the indexed field in support of
  757.    GoldDB                                                                    *)
  758.  
  759. function GetIndexedField(iFName : FnString;
  760.                          var fId : File) : Integer;    (* var for speed only *)
  761.  
  762. var
  763.     pRec : ParameterRecord;
  764.  
  765.     begin
  766.     FetchFileParameters(iFName,fId,pRec,SizeOf(pRec));
  767.     if BTreeErrorOccurred then Exit;
  768.  
  769.     GetIndexedField := pRec.iField;
  770.     end;                                   (* end of GetIndexedField routine *)
  771.  
  772.  
  773. (* This function returns the record number corresponding to the given entry
  774.    number.  An entry number is the relative number from the beginning of the
  775.    index.  In other words, entry number one is the first entry in the index.
  776.    It will return NULL if there is no corresponding record number.  This can
  777.    only happen if entryNum > number of entries in the index.                 *)
  778.  
  779.  
  780. function GetBTreeEntryLR(iFName : FnString;
  781.                          var fId : File;               (* var for speed only *)
  782.                          entryNum : LrNumber) : LrNumber;
  783.  
  784. var
  785.     pRec : ParameterRecord;
  786.     tempLr,
  787.     cnt  : LrNumber;
  788.     node : NodePtrType;
  789.     pg   : SinglePage;
  790.     done : Boolean;
  791.     bytePtr : PageRange;
  792.  
  793.     begin
  794.     FetchFileParameters(iFName,fId,pRec,SizeOf(pRec));
  795.     if BTreeErrorOccurred then Exit;
  796.  
  797.     cnt := 0;
  798.     node := pRec.fSNode;
  799.     done := FALSE;
  800.     while not done do
  801.         begin
  802.         FetchPage(iFName,fId,node,pg);
  803.         if BTreeErrorOccurred then Exit;
  804.         cnt := cnt + pg[VCNTLOC];
  805.         if entryNum <= cnt then
  806.             begin
  807.             cnt := cnt - pg[VCNTLOC];
  808.             bytePtr := ((RNSIZE + pRec.vSize) * ((entryNum - cnt) - 1)) + 1;
  809.             Move(pg[bytePtr],tempLr,RNSIZE);
  810.             done := TRUE;
  811.             end
  812.         else
  813.             begin
  814.             Move(pg[NEXTLOC],node,RNSIZE);
  815.             if node = NULL then
  816.                 begin
  817.                 done := TRUE;
  818.                 tempLr := NULL;
  819.                 end;
  820.             end;
  821.         end;
  822.     GetBTreeEntryLR := tempLr;
  823.     end;                                  (* end of GetBTreeEntryLR routine *)
  824.  
  825. (* This routine returns TRUE if the index is all upper case                 *)
  826.  
  827. function GetUpperCaseFlag(iFName : FnString;
  828.                           var fId : File) : Boolean;   (* var for speed only *)
  829.  
  830. var
  831.     pRec : ParameterRecord;
  832.  
  833.     begin
  834.     FetchFileParameters(iFName,fId,pRec,SizeOf(pRec));
  835.     if BTreeErrorOccurred then Exit;
  836.  
  837.     GetUpperCaseFlag := pRec.upperCaseFlag;
  838.     end;                                   (* end of GetIndexedField routine *)
  839.  
  840.  
  841. (* This routine will perform a partial or a full validation of an index file.
  842.    (depending on the value of the variable Partial).  A partial check will
  843.    validate that the pRec record (record 0) is intact and that the file
  844.    structure is valid.  A full validation will perform an additional check
  845.    to ensure that the data file and the index file are synchronized. The
  846.    routine will return one of the following values:
  847.  
  848.               0 : No errors
  849.              -1 : Header error
  850.              -2 : File error
  851.              -3 : Index and dat files not synchronized                      *)
  852.  
  853. function ValidateBTree(iFName : FnString;
  854.                        var fId : File                 (* var for speed only *)
  855.                        ): ValidationError;
  856.  
  857. var
  858.     pRec : ParameterRecord;
  859.     result : ValidationError;
  860.  
  861.     function NodeInUse(thisNode : NodePtrType) : Boolean;
  862.  
  863.         begin
  864.         NodeInUse := CheckBitInBitmap(iFName,fId,pRec.firstBMRec,thisNode);
  865.         end;
  866.  
  867.     function CheckVSizeAndVType : Boolean;
  868.  
  869.         begin
  870.         if (pRec.vSize < 1) or (pRec.vSize > MAXVALSIZE) then
  871.             begin
  872.             CheckVSizeAndVType := FALSE;
  873.             end
  874.         else
  875.             begin
  876.             if pRec.vType = STRINGVALUE then
  877.                 begin
  878.                 CheckVSizeAndVType := TRUE;
  879.                 end
  880.             else
  881.                 begin
  882.                 CheckVSizeAndVType := ((GetSizeFromVType(pRec.vType)
  883.                                         = pRec.vSize));
  884.                 end;
  885.             end;
  886.         end;
  887.  
  888.     begin
  889.  
  890.     FetchFileParameters(iFName,fId,pRec,SizeOf(pRec));
  891.     if BTreeErrorOccurred then Exit;
  892.  
  893.     if prec.version <> VERSIONINFO then
  894.         begin
  895.         ValidateBTree := PRECERROR;
  896.         Exit;
  897.         end;
  898.  
  899.     if (pRec.firstBMRec = NULL) or (pRec.lastBMRec = NULL) then
  900.         begin
  901.         ValidateBTree := PRECERROR;
  902.         Exit;
  903.         end;
  904.  
  905.     if NodeInUse(pRec.nextAvail) then
  906.         begin
  907.         ValidateBTree := PRECERROR;
  908.         Exit;
  909.         end;
  910.  
  911.     if BTreeErrorOccurred then Exit;
  912.     if not NodeInUse(pRec.rNode) then
  913.         begin
  914.         ValidateBTree := PRECERROR;
  915.         Exit;
  916.         end;
  917.  
  918.     if BTreeErrorOccurred then Exit;
  919.     if not NodeInUse(pRec.fSNode) then
  920.         begin
  921.         ValidateBTree := PRECERROR;
  922.         Exit;
  923.         end;
  924.  
  925.     if BTreeErrorOccurred then Exit;
  926.     if not NodeInUse(pRec.lSNode) then
  927.         begin
  928.         ValidateBTree := PRECERROR;
  929.         Exit;
  930.         end;
  931.  
  932.     if BTreeErrorOccurred then Exit;
  933.     if (pRec.vType <= INVALIDVALUE) or (pRec.vtype > BYTEARRAYVALUE) then
  934.         begin
  935.         ValidateBTree := PRECERROR;
  936.         Exit;
  937.         end;
  938.  
  939.     if not CheckVSizeAndVType then
  940.         begin
  941.         ValidateBTree := PRECERROR;
  942.         end
  943.     else
  944.         begin
  945.         ValidateBTree := NOERROR;
  946.         end;
  947.  
  948.     end;                                     (* end of ValidateBTree routine *)
  949.